codice fiscale
lele
l'algoritmo e relativi codice per calcolare il codice
fiscale? o magari un sito dove scaricate tale inforamzoni.
Grazie tanto ciao lele.
Alex
http://www.dotnethell.it/articles/article.aspx?ArticleID=84
"lele" <anon...@discussions.microsoft.com> ha scritto nel messaggio
news:087401c39f0b$9804e4a0$a001...@phx.gbl...
lele
scaricare i codici dei comuni possibilmente aggioranato a
pochi emsi fa grazie mille ciao lele
>-----Messaggio originale---
>Guarda questo link
>http://www.dotnethell.it/articles/article.aspx?
ArticleID=84
>
>
>
>"lele" <anon...@discussions.microsoft.com> ha scritto
nel messaggio
>news:087401c39f0b$9804e4a0$a001...@phx.gbl...
>> Ciao ragazzi, volevo chiedervi se qualcuno di voi aveva
>> l'algoritmo e relativi codice per calcolare il codice
>> fiscale? o magari un sito dove scaricate tale
inforamzoni.
>> Grazie tanto ciao lele.
>
>
>.
>
Ale
Public CP As String
Public Sesso As String
Function CalcCF(ByVal Cognome$, ByVal Nome$, ByVal DataNascita As Date,
ByVal Sesso$, ByVal Provincia$) As String
Dim temp As String
Dim Vocali As String
Dim Consonanti As String
Dim I As Integer
Dim AppoNum As Long
Dim TempNum As Long
Dim TxtCodFis As String
TxtCodFis = ""
Cognome$ = StrConv(Cognome$, VbStrConv.UpperCase)
Vocali = ""
Consonanti = ""
For I = 1 To Len(Cognome$)
If InStr("AEIOU", Mid(Cognome$, I, 1)) Then
Vocali = Vocali + Mid(Cognome$, I, 1)
ElseIf InStr("BCDFGHJKLMNPQRSTVWXYZ", Mid(Cognome$, I, 1)) Then
Consonanti = Consonanti + Mid(Cognome$, I, 1)
Else
' E' uno spazio, un apostrofo o altro che non va considerato
End If
If Len(Consonanti) = 3 Then Exit For
Next
If Len(Consonanti) < 3 Then Consonanti = Consonanti + Left(Vocali,
3 - Len(Consonanti))
If Len(Consonanti) < 3 Then Consonanti = Consonanti + Left(3 -
Len(Consonanti), "X")
TxtCodFis = Consonanti
'
' RICAVO IL NOME (456)
'
Nome$ = StrConv(Nome$, vbUpperCase)
Vocali = ""
Consonanti = ""
For I = 1 To Len(Nome$)
If InStr("AEIOU", Mid(Nome$, I, 1)) Then
Vocali = Vocali + Mid(Nome$, I, 1)
ElseIf InStr("BCDFGHJKLMNPQRSTVWXYZ", Mid(Nome$, I, 1)) Then
Consonanti = Consonanti + Mid(Nome$, I, 1)
Else
' E' uno spazio, un apostrofo o altro che non va considerato
End If
Next I
If Len(Consonanti) >= 4 Then
' isolo la prima, terza e quarta consonante
Consonanti = Left$(Consonanti, 1) & Mid$(Consonanti, 3, 2)
ElseIf Len(Consonanti) = 3 Then
' Va bene cosi'
Else
' Aggiungo le vocali
Consonanti = Left$(Consonanti & Vocali, 3)
' se non basta, aggiungo le X
If Len(Consonanti) < 3 Then Consonanti = Left$(Consonanti &
"XXX", 3)
End If
TxtCodFis = TxtCodFis & Consonanti
'
'Anno di nascita (78)
'
TxtCodFis = TxtCodFis + Right(Format$(DataNascita.Year, "0000"), 2)
'
'Mese di nascita(9)
'
TxtCodFis = TxtCodFis & Mid$("ABCDEHLMPRST", DataNascita.Month, 1)
'
'Giorno di nascita(0A)
Sesso = Sesso$
If UCase(Sesso$) = "F" Then
TxtCodFis = TxtCodFis & Format$(DataNascita.Day + 40, "00")
Else
TxtCodFis = TxtCodFis & Format$(DataNascita.Day, "00")
End If
'
'Località di nascita (BCDE)
'
TxtCodFis = TxtCodFis & CP
'
'Ultima lettera (F)
'
'Controllo caratteri pari
TempNum = 0
I = 1
Do
' I DISPARI
AppoNum =
InStr("B1A0KKPPLLC2QQD3RRE4VVOOSSF5TTG6UUH7MMI8NNJ9WWZZYYXX", Mid(TxtCodFis,
I, 1))
TempNum = TempNum + ((AppoNum - 1) And &H7FFE) / 2
I = I + 1
If I > 15 Then Exit Do
' I PARI
AppoNum =
InStr("A0B1C2D3E4F5G6H7I8J9KKLLMMNNOOPPQQRRSSTTUUVVWWXXYYZZ", Mid(TxtCodFis,
I, 1))
TempNum = TempNum + ((AppoNum - 1) And &H7FFE) / 2
I = I + 1
Loop
TempNum = TempNum Mod 26
TxtCodFis = TxtCodFis & Mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZ", TempNum +
1, 1)
' Ecco qui il codice bello finito
CalcCF = TxtCodFis
End Function
End Module
Ovviamente devi aggiungere il codice del comune di nascita che devi estrarre
dal database di riferimento!
"lele" <anon...@discussions.microsoft.com> ha scritto nel messaggio
news:087401c39f0b$9804e4a0$a001...@phx.gbl...